home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tkCanvPs.c < prev    next >
C/C++ Source or Header  |  1995-06-19  |  36KB  |  1,133 lines
  1. /* 
  2.  * tkCanvPs.c --
  3.  *
  4.  *    This module provides Postscript output support for canvases,
  5.  *    including the "postscript" widget command plus a few utility
  6.  *    procedures used for generating Postscript.
  7.  *
  8.  * Copyright (c) 1991-1994 The Regents of the University of California.
  9.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  */
  14.  
  15. static char sccsid[] = "@(#) tkCanvPs.c 1.35 95/06/19 10:04:58";
  16.  
  17. #include <stdio.h>
  18. #include "tkInt.h"
  19. #include "tkCanvas.h"
  20. #include "tkPort.h"
  21.  
  22. /*
  23.  * See tkCanvas.h for key data structures used to implement canvases.
  24.  */
  25.  
  26. /*
  27.  * One of the following structures is created to keep track of Postscript
  28.  * output being generated.  It consists mostly of information provided on
  29.  * the widget command line.
  30.  */
  31.  
  32. typedef struct TkPostscriptInfo {
  33.     int x, y, width, height;    /* Area to print, in canvas pixel
  34.                  * coordinates. */
  35.     int x2, y2;            /* x+width and y+height. */
  36.     char *pageXString;        /* String value of "-pagex" option or NULL. */
  37.     char *pageYString;        /* String value of "-pagey" option or NULL. */
  38.     double pageX, pageY;    /* Postscript coordinates (in points)
  39.                  * corresponding to pageXString and
  40.                  * pageYString. Don't forget that y-values
  41.                  * grow upwards for Postscript! */
  42.     char *pageWidthString;    /* Printed width of output. */
  43.     char *pageHeightString;    /* Printed height of output. */
  44.     double scale;        /* Scale factor for conversion: each pixel
  45.                  * maps into this many points. */
  46.     Tk_Anchor pageAnchor;    /* How to anchor bbox on Postscript page. */
  47.     int rotate;            /* Non-zero means output should be rotated
  48.                  * on page (landscape mode). */
  49.     char *fontVar;        /* If non-NULL, gives name of global variable
  50.                  * containing font mapping information.
  51.                  * Malloc'ed. */
  52.     char *colorVar;        /* If non-NULL, give name of global variable
  53.                  * containing color mapping information.
  54.                  * Malloc'ed. */
  55.     char *colorMode;        /* Mode for handling colors:  "monochrome",
  56.                  * "gray", or "color".  Malloc'ed. */
  57.     int colorLevel;        /* Numeric value corresponding to colorMode:
  58.                  * 0 for mono, 1 for gray, 2 for color. */
  59.     char *fileName;        /* Name of file in which to write Postscript;
  60.                  * NULL means return Postscript info as
  61.                  * result. Malloc'ed. */
  62.     FILE *f;            /* Open file corresponding to fileName. */
  63.     Tcl_HashTable fontTable;    /* Hash table containing names of all font
  64.                  * families used in output.  The hash table
  65.                  * values are not used. */
  66.     int prepass;        /* Non-zero means that we're currently in
  67.                  * the pre-pass that collects font information,
  68.                  * so the Postscript generated isn't
  69.                  * relevant. */
  70. } TkPostscriptInfo;
  71.  
  72. /*
  73.  * The table below provides a template that's used to process arguments
  74.  * to the canvas "postscript" command and fill in TkPostscriptInfo
  75.  * structures.
  76.  */
  77.  
  78. static Tk_ConfigSpec configSpecs[] = {
  79.     {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
  80.     "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
  81.     {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
  82.     "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
  83.     {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
  84.     "", Tk_Offset(TkPostscriptInfo, fileName), 0},
  85.     {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
  86.     "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
  87.     {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
  88.     "", Tk_Offset(TkPostscriptInfo, height), 0},
  89.     {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
  90.     "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
  91.     {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
  92.     "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
  93.     {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
  94.     "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
  95.     {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
  96.     "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
  97.     {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
  98.     "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
  99.     {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
  100.     "", Tk_Offset(TkPostscriptInfo, rotate), 0},
  101.     {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
  102.     "", Tk_Offset(TkPostscriptInfo, width), 0},
  103.     {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
  104.     "", Tk_Offset(TkPostscriptInfo, x), 0},
  105.     {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
  106.     "", Tk_Offset(TkPostscriptInfo, y), 0},
  107.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  108.     (char *) NULL, 0, 0}
  109. };
  110.  
  111. /*
  112.  * Forward declarations for procedures defined later in this file:
  113.  */
  114.  
  115. static int        GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
  116.                 char *string, double *doublePtr));
  117.  
  118. /*
  119.  *--------------------------------------------------------------
  120.  *
  121.  * TkCanvPostscriptCmd --
  122.  *
  123.  *    This procedure is invoked to process the "postscript" options
  124.  *    of the widget command for canvas widgets. See the user
  125.  *    documentation for details on what it does.
  126.  *
  127.  * Results:
  128.  *    A standard Tcl result.
  129.  *
  130.  * Side effects:
  131.  *    See the user documentation.
  132.  *
  133.  *--------------------------------------------------------------
  134.  */
  135.  
  136.     /* ARGSUSED */
  137. int
  138. TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
  139.     TkCanvas *canvasPtr;        /* Information about canvas widget. */
  140.     Tcl_Interp *interp;            /* Current interpreter. */
  141.     int argc;                /* Number of arguments. */
  142.     char **argv;            /* Argument strings.  Caller has
  143.                      * already parsed this command enough
  144.                      * to know that argv[1] is
  145.                      * "postscript". */
  146. {
  147.     TkPostscriptInfo psInfo, *oldInfoPtr;
  148.     int result = TCL_ERROR;
  149.     Tk_Item *itemPtr;
  150. #define STRING_LENGTH 400
  151.     char string[STRING_LENGTH+1], *p;
  152.     time_t now;
  153.     struct passwd *pwPtr;
  154.     FILE *f;
  155.     size_t length;
  156.     int deltaX = 0, deltaY = 0;        /* Offset of lower-left corner of
  157.                      * area to be marked up, measured
  158.                      * in canvas units from the positioning
  159.                      * point on the page (reflects
  160.                      * anchor position).  Initial values
  161.                      * needed only to stop compiler
  162.                      * warnings. */
  163.     Tcl_HashSearch search;
  164.     Tcl_HashEntry *hPtr;
  165.     Tcl_DString buffer;
  166.     char *libDir;
  167.  
  168.     /*
  169.      *----------------------------------------------------------------
  170.      * Initialize the data structure describing Postscript generation,
  171.      * then process all the arguments to fill the data structure in.
  172.      *----------------------------------------------------------------
  173.      */
  174.  
  175.     oldInfoPtr = canvasPtr->psInfoPtr;
  176.     canvasPtr->psInfoPtr = &psInfo;
  177.     psInfo.x = canvasPtr->xOrigin;
  178.     psInfo.y = canvasPtr->yOrigin;
  179.     psInfo.width = -1;
  180.     psInfo.height = -1;
  181.     psInfo.pageXString = NULL;
  182.     psInfo.pageYString = NULL;
  183.     psInfo.pageX = 72*4.25;
  184.     psInfo.pageY = 72*5.5;
  185.     psInfo.pageWidthString = NULL;
  186.     psInfo.pageHeightString = NULL;
  187.     psInfo.scale = 1.0;
  188.     psInfo.pageAnchor = TK_ANCHOR_CENTER;
  189.     psInfo.rotate = 0;
  190.     psInfo.fontVar = NULL;
  191.     psInfo.colorVar = NULL;
  192.     psInfo.colorMode = NULL;
  193.     psInfo.colorLevel = 0;
  194.     psInfo.fileName = NULL;
  195.     psInfo.f = NULL;
  196.     psInfo.prepass = 0;
  197.     Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
  198.     result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
  199.         configSpecs, argc-2, argv+2, (char *) &psInfo,
  200.         TK_CONFIG_ARGV_ONLY);
  201.     if (result != TCL_OK) {
  202.     goto cleanup;
  203.     }
  204.  
  205.     if (psInfo.width == -1) {
  206.     psInfo.width = Tk_Width(canvasPtr->tkwin);
  207.     }
  208.     if (psInfo.height == -1) {
  209.     psInfo.height = Tk_Height(canvasPtr->tkwin);
  210.     }
  211.     psInfo.x2 = psInfo.x + psInfo.width;
  212.     psInfo.y2 = psInfo.y + psInfo.height;
  213.  
  214.     if (psInfo.pageXString != NULL) {
  215.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
  216.         &psInfo.pageX) != TCL_OK) {
  217.         goto cleanup;
  218.     }
  219.     }
  220.     if (psInfo.pageYString != NULL) {
  221.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
  222.         &psInfo.pageY) != TCL_OK) {
  223.         goto cleanup;
  224.     }
  225.     }
  226.     if (psInfo.pageWidthString != NULL) {
  227.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
  228.         &psInfo.scale) != TCL_OK) {
  229.         goto cleanup;
  230.     }
  231.     psInfo.scale /= psInfo.width;
  232.     } else if (psInfo.pageHeightString != NULL) {
  233.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
  234.         &psInfo.scale) != TCL_OK) {
  235.         goto cleanup;
  236.     }
  237.     psInfo.scale /= psInfo.height;
  238.     } else {
  239.     psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
  240.     psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
  241.     }
  242.     switch (psInfo.pageAnchor) {
  243.     case TK_ANCHOR_NW:
  244.     case TK_ANCHOR_W:
  245.     case TK_ANCHOR_SW:
  246.         deltaX = 0;
  247.         break;
  248.     case TK_ANCHOR_N:
  249.     case TK_ANCHOR_CENTER:
  250.     case TK_ANCHOR_S:
  251.         deltaX = -psInfo.width/2;
  252.         break;
  253.     case TK_ANCHOR_NE:
  254.     case TK_ANCHOR_E:
  255.     case TK_ANCHOR_SE:
  256.         deltaX = -psInfo.width;
  257.         break;
  258.     }
  259.     switch (psInfo.pageAnchor) {
  260.     case TK_ANCHOR_NW:
  261.     case TK_ANCHOR_N:
  262.     case TK_ANCHOR_NE:
  263.         deltaY = - psInfo.height;
  264.         break;
  265.     case TK_ANCHOR_W:
  266.     case TK_ANCHOR_CENTER:
  267.     case TK_ANCHOR_E:
  268.         deltaY = -psInfo.height/2;
  269.         break;
  270.     case TK_ANCHOR_SW:
  271.     case TK_ANCHOR_S:
  272.     case TK_ANCHOR_SE:
  273.         deltaY = 0;
  274.         break;
  275.     }
  276.  
  277.     if (psInfo.colorMode == NULL) {
  278.     psInfo.colorLevel = 2;
  279.     } else {
  280.     length = strlen(psInfo.colorMode);
  281.     if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
  282.         psInfo.colorLevel = 0;
  283.     } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
  284.         psInfo.colorLevel = 1;
  285.     } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
  286.         psInfo.colorLevel = 2;
  287.     } else {
  288.         Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
  289.             psInfo.colorMode, "\": must be monochrome, ",
  290.             "gray, or color", (char *) NULL);
  291.         goto cleanup;
  292.     }
  293.     }
  294.  
  295.     if (psInfo.fileName != NULL) {
  296.     p = Tcl_TildeSubst(canvasPtr->interp, psInfo.fileName, &buffer);
  297.     if (p == NULL) {
  298.         goto cleanup;
  299.     }
  300.     psInfo.f = fopen(p, "w");
  301.     Tcl_DStringFree(&buffer);
  302.     if (psInfo.f == NULL) {
  303.         Tcl_AppendResult(canvasPtr->interp, "couldn't write file \"",
  304.             psInfo.fileName, "\": ",
  305.             Tcl_PosixError(canvasPtr->interp), (char *) NULL);
  306.         goto cleanup;
  307.     }
  308.     }
  309.  
  310.     /*
  311.      *--------------------------------------------------------
  312.      * Make a pre-pass over all of the items, generating Postscript
  313.      * and then throwing it away.  The purpose of this pass is just
  314.      * to collect information about all the fonts in use, so that
  315.      * we can output font information in the proper form required
  316.      * by the Document Structuring Conventions.
  317.      *--------------------------------------------------------
  318.      */
  319.  
  320.     psInfo.prepass = 1;
  321.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  322.         itemPtr = itemPtr->nextPtr) {
  323.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  324.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  325.         continue;
  326.     }
  327.     if (itemPtr->typePtr->postscriptProc == NULL) {
  328.         continue;
  329.     }
  330.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  331.         (Tk_Canvas) canvasPtr, itemPtr, 1);
  332.     Tcl_ResetResult(canvasPtr->interp);
  333.     if (result != TCL_OK) {
  334.         /*
  335.          * An error just occurred.  Just skip out of this loop.
  336.          * There's no need to report the error now;  it can be
  337.          * reported later (errors can happen later that don't
  338.          * happen now, so we still have to check for errors later
  339.          * anyway).
  340.          */
  341.         break;
  342.     }
  343.     }
  344.     psInfo.prepass = 0;
  345.  
  346.     /*
  347.      *--------------------------------------------------------
  348.      * Generate the header and prolog for the Postscript.
  349.      *--------------------------------------------------------
  350.      */
  351.  
  352.     Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
  353.         "%%Creator: Tk Canvas Widget\n", (char *) NULL);
  354.     pwPtr = getpwuid(getuid());
  355.     Tcl_AppendResult(canvasPtr->interp, "%%For: ",
  356.         (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
  357.         (char *) NULL);
  358.     endpwent();
  359.     Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
  360.         Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
  361.     time(&now);
  362.     Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
  363.         ctime(&now), (char *) NULL);
  364.     if (!psInfo.rotate) {
  365.     sprintf(string, "%d %d %d %d",
  366.         (int) (psInfo.pageX + psInfo.scale*deltaX),
  367.         (int) (psInfo.pageY + psInfo.scale*deltaY),
  368.         (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
  369.             + 1.0),
  370.         (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
  371.             + 1.0));
  372.     } else {
  373.     sprintf(string, "%d %d %d %d",
  374.         (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
  375.         (int) (psInfo.pageY + psInfo.scale*deltaX),
  376.         (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
  377.         (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
  378.             + 1.0));
  379.     }
  380.     Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
  381.         "\n", (char *) NULL);
  382.     Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", 
  383.         "%%DocumentData: Clean7Bit\n", (char *) NULL);
  384.     Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
  385.         psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
  386.     p = "%%DocumentNeededResources: font ";
  387.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  388.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  389.     Tcl_AppendResult(canvasPtr->interp, p,
  390.         Tcl_GetHashKey(&psInfo.fontTable, hPtr),
  391.         "\n", (char *) NULL);
  392.     p = "%%+ font ";
  393.     }
  394.     Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
  395.  
  396.     /*
  397.      * Read a standard prolog file from disk and insert it into
  398.      * the Postscript.
  399.      */
  400.  
  401.     libDir = Tcl_GetVar(canvasPtr->interp, "tk_library", TCL_GLOBAL_ONLY);
  402.     if (libDir == NULL) {
  403.     Tcl_ResetResult(canvasPtr->interp);
  404.     Tcl_AppendResult(canvasPtr->interp, "couldn't find library directory: ",
  405.         "tk_library variable doesn't exist", (char *) NULL);
  406.     goto cleanup;
  407.     }
  408.     sprintf(string, "%.350s/prolog.ps", libDir);
  409.     f = fopen(string, "r");
  410.     if (f == NULL) {
  411.     Tcl_ResetResult(canvasPtr->interp);
  412.     Tcl_AppendResult(canvasPtr->interp, "couldn't open prolog file \"",
  413.         string, "\": ", Tcl_PosixError(canvasPtr->interp),
  414.         (char *) NULL);
  415.     goto cleanup;
  416.     }
  417.     while (fgets(string, STRING_LENGTH, f) != NULL) {
  418.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  419.     }
  420.     if (ferror(f)) {
  421.     fclose(f);
  422.     Tcl_ResetResult(canvasPtr->interp);
  423.     Tcl_AppendResult(canvasPtr->interp, "error reading prolog file \"",
  424.         string, "\": ",
  425.         Tcl_PosixError(canvasPtr->interp), (char *) NULL);
  426.     goto cleanup;
  427.     }
  428.     fclose(f);
  429.     if (psInfo.f != NULL) {
  430.     fputs(canvasPtr->interp->result, psInfo.f);
  431.     Tcl_ResetResult(canvasPtr->interp);
  432.     }
  433.  
  434.     /*
  435.      *-----------------------------------------------------------
  436.      * Document setup:  set the color level and include fonts.
  437.      *-----------------------------------------------------------
  438.      */
  439.  
  440.     sprintf(string, "/CL %d def\n", psInfo.colorLevel);
  441.     Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
  442.         (char *) NULL);
  443.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  444.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  445.     Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
  446.         Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
  447.     }
  448.     Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
  449.  
  450.     /*
  451.      *-----------------------------------------------------------
  452.      * Page setup:  move to page positioning point, rotate if
  453.      * needed, set scale factor, offset for proper anchor position,
  454.      * and set clip region.
  455.      *-----------------------------------------------------------
  456.      */
  457.  
  458.     Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
  459.         (char *) NULL);
  460.     sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
  461.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  462.     if (psInfo.rotate) {
  463.     Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
  464.     }
  465.     sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
  466.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  467.     sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
  468.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  469.     sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
  470.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  471.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  472.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
  473.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
  474.     Tcl_AppendResult(canvasPtr->interp, string,
  475.     " lineto closepath clip newpath\n", (char *) NULL);
  476.     if (psInfo.f != NULL) {
  477.     fputs(canvasPtr->interp->result, psInfo.f);
  478.     Tcl_ResetResult(canvasPtr->interp);
  479.     }
  480.  
  481.     /*
  482.      *---------------------------------------------------------------------
  483.      * Iterate through all the items, having each relevant one draw itself.
  484.      * Quit if any of the items returns an error.
  485.      *---------------------------------------------------------------------
  486.      */
  487.  
  488.     result = TCL_OK;
  489.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  490.         itemPtr = itemPtr->nextPtr) {
  491.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  492.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  493.         continue;
  494.     }
  495.     if (itemPtr->typePtr->postscriptProc == NULL) {
  496.         continue;
  497.     }
  498.     Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
  499.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  500.         (Tk_Canvas) canvasPtr, itemPtr, 0);
  501.     if (result != TCL_OK) {
  502.         char msg[100];
  503.  
  504.         sprintf(msg, "\n    (generating Postscript for item %d)",
  505.             itemPtr->id);
  506.         Tcl_AddErrorInfo(canvasPtr->interp, msg);
  507.         goto cleanup;
  508.     }
  509.     Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
  510.     if (psInfo.f != NULL) {
  511.         fputs(canvasPtr->interp->result, psInfo.f);
  512.         Tcl_ResetResult(canvasPtr->interp);
  513.     }
  514.     }
  515.  
  516.     /*
  517.      *---------------------------------------------------------------------
  518.      * Output page-end information, such as commands to print the page
  519.      * and document trailer stuff.
  520.      *---------------------------------------------------------------------
  521.      */
  522.  
  523.     Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
  524.         "%%Trailer\nend\n%%EOF\n", (char *) NULL);
  525.     if (psInfo.f != NULL) {
  526.     fputs(canvasPtr->interp->result, psInfo.f);
  527.     Tcl_ResetResult(canvasPtr->interp);
  528.     }
  529.  
  530.     /*
  531.      * Clean up psInfo to release malloc'ed stuff.
  532.      */
  533.  
  534.     cleanup:
  535.     if (psInfo.pageXString != NULL) {
  536.     ckfree(psInfo.pageXString);
  537.     }
  538.     if (psInfo.pageYString != NULL) {
  539.     ckfree(psInfo.pageYString);
  540.     }
  541.     if (psInfo.pageWidthString != NULL) {
  542.     ckfree(psInfo.pageWidthString);
  543.     }
  544.     if (psInfo.pageHeightString != NULL) {
  545.     ckfree(psInfo.pageHeightString);
  546.     }
  547.     if (psInfo.fontVar != NULL) {
  548.     ckfree(psInfo.fontVar);
  549.     }
  550.     if (psInfo.colorVar != NULL) {
  551.     ckfree(psInfo.colorVar);
  552.     }
  553.     if (psInfo.colorMode != NULL) {
  554.     ckfree(psInfo.colorMode);
  555.     }
  556.     if (psInfo.fileName != NULL) {
  557.     ckfree(psInfo.fileName);
  558.     }
  559.     if (psInfo.f != NULL) {
  560.     fclose(psInfo.f);
  561.     }
  562.     Tcl_DeleteHashTable(&psInfo.fontTable);
  563.     canvasPtr->psInfoPtr = oldInfoPtr;
  564.     return result;
  565. }
  566.  
  567. /*
  568.  *--------------------------------------------------------------
  569.  *
  570.  * Tk_CanvasPsColor --
  571.  *
  572.  *    This procedure is called by individual canvas items when
  573.  *    they want to set a color value for output.  Given information
  574.  *    about an X color, this procedure will generate Postscript
  575.  *    commands to set up an appropriate color in Postscript.
  576.  *
  577.  * Results:
  578.  *    Returns a standard Tcl return value.  If an error occurs
  579.  *    then an error message will be left in interp->result.
  580.  *    If no error occurs, then additional Postscript will be
  581.  *    appended to interp->result.
  582.  *
  583.  * Side effects:
  584.  *    None.
  585.  *
  586.  *--------------------------------------------------------------
  587.  */
  588.  
  589. int
  590. Tk_CanvasPsColor(interp, canvas, colorPtr)
  591.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  592.                      * or error message. */
  593.     Tk_Canvas canvas;            /* Information about canvas. */
  594.     XColor *colorPtr;            /* Information about color. */
  595. {
  596.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  597.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  598.     int tmp;
  599.     double red, green, blue;
  600.     char string[200];
  601.  
  602.     if (psInfoPtr->prepass) {
  603.     return TCL_OK;
  604.     }
  605.  
  606.     /*
  607.      * If there is a color map defined, then look up the color's name
  608.      * in the map and use the Postscript commands found there, if there
  609.      * are any.
  610.      */
  611.  
  612.     if (psInfoPtr->colorVar != NULL) {
  613.     char *cmdString;
  614.  
  615.     cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
  616.         Tk_NameOfColor(colorPtr), 0);
  617.     if (cmdString != NULL) {
  618.         Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
  619.         return TCL_OK;
  620.     }
  621.     }
  622.  
  623.     /*
  624.      * No color map entry for this color.  Grab the color's intensities
  625.      * and output Postscript commands for them.  Special note:  X uses
  626.      * a range of 0-65535 for intensities, but most displays only use
  627.      * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
  628.      * X scale.  This means that there's no way to get perfect white,
  629.      * since the highest intensity is only 65280 out of 65535.  To
  630.      * work around this problem, rescale the X intensity to a 0-255
  631.      * scale and use that as the basis for the Postscript colors.  This
  632.      * scheme still won't work if the display only uses 4 bits per color,
  633.      * but most diplays use at least 8 bits.
  634.      */
  635.  
  636.     tmp = colorPtr->red;
  637.     red = ((double) (tmp >> 8))/255.0;
  638.     tmp = colorPtr->green;
  639.     green = ((double) (tmp >> 8))/255.0;
  640.     tmp = colorPtr->blue;
  641.     blue = ((double) (tmp >> 8))/255.0;
  642.     sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
  643.         red, green, blue);
  644.     Tcl_AppendResult(interp, string, (char *) NULL);
  645.     return TCL_OK;
  646. }
  647.  
  648. /*
  649.  *--------------------------------------------------------------
  650.  *
  651.  * Tk_CanvasPsFont --
  652.  *
  653.  *    This procedure is called by individual canvas items when
  654.  *    they want to output text.  Given information about an X
  655.  *    font, this procedure will generate Postscript commands
  656.  *    to set up an appropriate font in Postscript.
  657.  *
  658.  * Results:
  659.  *    Returns a standard Tcl return value.  If an error occurs
  660.  *    then an error message will be left in interp->result.
  661.  *    If no error occurs, then additional Postscript will be
  662.  *    appended to the interp->result.
  663.  *
  664.  * Side effects:
  665.  *    The Postscript font name is entered into psInfoPtr->fontTable
  666.  *    if it wasn't already there.
  667.  *
  668.  *--------------------------------------------------------------
  669.  */
  670.  
  671. int
  672. Tk_CanvasPsFont(interp, canvas, fontStructPtr)
  673.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  674.                      * or error message. */
  675.     Tk_Canvas canvas;            /* Information about canvas. */
  676.     XFontStruct *fontStructPtr;        /* Information about font in which text
  677.                      * is to be printed. */
  678. {
  679.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  680.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  681.     char *name, *end, *weightString, *slantString;
  682. #define TOTAL_FIELDS    8
  683. #define FAMILY_FIELD    1
  684. #define WEIGHT_FIELD    2
  685. #define SLANT_FIELD    3
  686. #define SIZE_FIELD    7
  687.     char *fieldPtrs[TOTAL_FIELDS];
  688. #define MAX_NAME_SIZE 100
  689.     char fontName[MAX_NAME_SIZE+50], pointString[20];
  690.     int i, c, weightSize, nameSize, points;
  691.     char *p;
  692.  
  693.     name = Tk_NameOfFontStruct(fontStructPtr);
  694.  
  695.     /*
  696.      * First, look up the font's name in the font map, if there is one.
  697.      * If there is an entry for this font, it consists of a list
  698.      * containing font name and size.  Use this information.
  699.      */
  700.  
  701.     if (psInfoPtr->fontVar != NULL) {
  702.     char *list, **argv;
  703.     int argc;
  704.     double size;
  705.  
  706.     list = Tcl_GetVar2(interp, psInfoPtr->fontVar,
  707.         name, 0);
  708.     if (list != NULL) {
  709.         if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
  710.         badMapEntry:
  711.         Tcl_ResetResult(interp);
  712.         Tcl_AppendResult(interp, "bad font map entry for \"", name,
  713.             "\": \"", list, "\"", (char *) NULL);
  714.         return TCL_ERROR;
  715.         }
  716.         if (argc != 2) {
  717.         goto badMapEntry;
  718.         }
  719.         size = strtod(argv[1], &end);
  720.         if ((size <= 0) || (*end != 0)) {
  721.         goto badMapEntry;
  722.         }
  723.         sprintf(pointString, "%.15g", size);
  724.         Tcl_AppendResult(interp, "/", argv[0], " findfont ",
  725.             pointString, " scalefont setfont\n", (char *) NULL);
  726.         Tcl_CreateHashEntry(&psInfoPtr->fontTable, argv[0], &i);
  727.         ckfree((char *) argv);
  728.         return TCL_OK;
  729.     }
  730.     }
  731.  
  732.     /*
  733.      * Not in the font map.  Try to parse the name to get four fields:
  734.      * family name, weight, slant, and point size.  To do this, split the
  735.      * font name up into fields, storing pointers to the first character
  736.      * of each field in fieldPtrs.
  737.      */
  738.  
  739.     if (name[0] != '-') {
  740.     goto error;
  741.     }
  742.     for (p =  name+1, i = 0; i < TOTAL_FIELDS; i++) {
  743.     fieldPtrs[i] = p;
  744.     while (*p != '-') {
  745.         if (*p == 0) {
  746.         goto error;
  747.         }
  748.         p++;
  749.     }
  750.     p++;
  751.     }
  752.  
  753.     /*
  754.      * Use the information from the X font name to make a guess at a
  755.      * Postscript font name of the form "<family>-<weight><slant>" where
  756.      * <weight> and <slant> may be omitted and if both are omitted then
  757.      * the dash is also omitted.  Postscript is very picky about font names,
  758.      * so there are several heuristics in the code below (e.g. don't
  759.      * include a "Roman" slant except for "Times" font, and make sure
  760.      * that the first letter of each field is capitalized but no other
  761.      * letters are in caps).
  762.      */
  763.  
  764.     nameSize = fieldPtrs[FAMILY_FIELD+1] - 1 - fieldPtrs[FAMILY_FIELD];
  765.     if ((nameSize == 0) || (nameSize > MAX_NAME_SIZE)) {
  766.     goto error;
  767.     }
  768.     strncpy(fontName, fieldPtrs[FAMILY_FIELD], (size_t) nameSize);
  769.     if (islower(UCHAR(fontName[0]))) {
  770.     fontName[0] = toupper(fontName[0]);
  771.     }
  772.     for (p = fontName+1, i = nameSize-1; i > 0; p++, i--) {
  773.     if (isupper(UCHAR(*p))) {
  774.         *p = tolower(*p);
  775.     }
  776.     }
  777.     *p = 0;
  778.     weightSize = fieldPtrs[WEIGHT_FIELD+1] - 1 - fieldPtrs[WEIGHT_FIELD];
  779.     if (weightSize == 0) {
  780.     goto error;
  781.     }
  782.     if (strncasecmp(fieldPtrs[WEIGHT_FIELD], "medium",
  783.         (size_t) weightSize) == 0) {
  784.     weightString = "";
  785.     } else if (strncasecmp(fieldPtrs[WEIGHT_FIELD], "bold",
  786.         (size_t) weightSize) == 0) {
  787.     weightString = "Bold";
  788.     } else {
  789.     goto error;
  790.     }
  791.     if (fieldPtrs[SLANT_FIELD+1] != (fieldPtrs[SLANT_FIELD] + 2)) {
  792.     goto error;
  793.     }
  794.     c = fieldPtrs[SLANT_FIELD][0];
  795.     if ((c == 'r') || (c == 'R')) {
  796.     slantString = "";
  797.     if ((weightString[0] == 0) && (nameSize == 5)
  798.         && (strncmp(fontName, "Times", 5) == 0)) {
  799.         slantString = "Roman";
  800.     }
  801.     } else if ((c == 'i') || (c == 'I')) {
  802.     slantString = "Italic";
  803.     } else if ((c == 'o') || (c == 'O')) {
  804.     slantString = "Oblique";
  805.     } else {
  806.     goto error;
  807.     }
  808.     if ((weightString[0] != 0) || (slantString[0] != 0)) {
  809.     sprintf(p, "-%s%s", weightString, slantString);
  810.     }
  811.     points = strtoul(fieldPtrs[SIZE_FIELD], &end, 0);
  812.     if (points == 0) {
  813.     goto error;
  814.     }
  815.     sprintf(pointString, "%.15g", ((double) points)/10.0);
  816.     Tcl_AppendResult(interp, "/", fontName, " findfont ",
  817.         pointString, " scalefont setfont\n", (char *) NULL);
  818.     Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontName, &i);
  819.     return TCL_OK;
  820.  
  821.     error:
  822.     Tcl_ResetResult(interp);
  823.     Tcl_AppendResult(interp, "couldn't translate font name \"",
  824.         name, "\" to Postscript", (char *) NULL);
  825.     return TCL_ERROR;
  826. }
  827.  
  828. /*
  829.  *--------------------------------------------------------------
  830.  *
  831.  * Tk_CanvasPsBitmap --
  832.  *
  833.  *    This procedure is called to output the contents of a
  834.  *    sub-region of a bitmap in proper image data format for
  835.  *    Postscript (i.e. data between angle brackets, one bit
  836.  *    per pixel).
  837.  *
  838.  * Results:
  839.  *    Returns a standard Tcl return value.  If an error occurs
  840.  *    then an error message will be left in interp->result.
  841.  *    If no error occurs, then additional Postscript will be
  842.  *    appended to interp->result.
  843.  *
  844.  * Side effects:
  845.  *    None.
  846.  *
  847.  *--------------------------------------------------------------
  848.  */
  849.  
  850. int
  851. Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
  852.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  853.                      * or error message. */
  854.     Tk_Canvas canvas;            /* Information about canvas. */
  855.     Pixmap bitmap;            /* Bitmap for which to generate
  856.                      * Postscript. */
  857.     int startX, startY;            /* Coordinates of upper-left corner
  858.                      * of rectangular region to output. */
  859.     int width, height;            /* Height of rectangular region. */
  860. {
  861.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  862.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  863.     XImage *imagePtr;
  864.     int charsInLine, x, y, lastX, lastY, value, mask;
  865.     unsigned int totalWidth, totalHeight;
  866.     char string[100];
  867.     Window dummyRoot;
  868.     int dummyX, dummyY;
  869.     unsigned dummyBorderwidth, dummyDepth;
  870.  
  871.     if (psInfoPtr->prepass) {
  872.     return TCL_OK;
  873.     }
  874.  
  875.     /*
  876.      * The following call should probably be a call to Tk_SizeOfBitmap
  877.      * instead, but it seems that we are occasionally invoked by custom
  878.      * item types that create their own bitmaps without registering them
  879.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  880.      * it shouldn't matter here.
  881.      */
  882.  
  883.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  884.         &dummyX, &dummyY, (unsigned int *) &totalWidth,
  885.         (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
  886.     imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
  887.         totalWidth, totalHeight, 1, XYPixmap);
  888.     Tcl_AppendResult(interp, "<", (char *) NULL);
  889.     mask = 0x80;
  890.     value = 0;
  891.     charsInLine = 0;
  892.     lastX = startX + width - 1;
  893.     lastY = startY + height - 1;
  894.     for (y = lastY; y >= startY; y--) {
  895.     for (x = startX; x <= lastX; x++) {
  896.         if (XGetPixel(imagePtr, x, y)) {
  897.         value |= mask;
  898.         }
  899.         mask >>= 1;
  900.         if (mask == 0) {
  901.         sprintf(string, "%02x", value);
  902.         Tcl_AppendResult(interp, string, (char *) NULL);
  903.         mask = 0x80;
  904.         value = 0;
  905.         charsInLine += 2;
  906.         if (charsInLine >= 60) {
  907.             Tcl_AppendResult(interp, "\n", (char *) NULL);
  908.             charsInLine = 0;
  909.         }
  910.         }
  911.     }
  912.     if (mask != 0x80) {
  913.         sprintf(string, "%02x", value);
  914.         Tcl_AppendResult(interp, string, (char *) NULL);
  915.         mask = 0x80;
  916.         value = 0;
  917.         charsInLine += 2;
  918.     }
  919.     }
  920.     Tcl_AppendResult(interp, ">", (char *) NULL);
  921.     XDestroyImage(imagePtr);
  922.     return TCL_OK;
  923. }
  924.  
  925. /*
  926.  *--------------------------------------------------------------
  927.  *
  928.  * Tk_CanvasPsStipple --
  929.  *
  930.  *    This procedure is called by individual canvas items when
  931.  *    they have created a path that they'd like to be filled with
  932.  *    a stipple pattern.  Given information about an X bitmap,
  933.  *    this procedure will generate Postscript commands to fill
  934.  *    the current clip region using a stipple pattern defined by the
  935.  *    bitmap.
  936.  *
  937.  * Results:
  938.  *    Returns a standard Tcl return value.  If an error occurs
  939.  *    then an error message will be left in interp->result.
  940.  *    If no error occurs, then additional Postscript will be
  941.  *    appended to interp->result.
  942.  *
  943.  * Side effects:
  944.  *    None.
  945.  *
  946.  *--------------------------------------------------------------
  947.  */
  948.  
  949. int
  950. Tk_CanvasPsStipple(interp, canvas, bitmap)
  951.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  952.                      * or error message. */
  953.     Tk_Canvas canvas;            /* Information about canvas. */
  954.     Pixmap bitmap;            /* Bitmap to use for stippling. */
  955. {
  956.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  957.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  958.     int width, height;
  959.     char string[100];
  960.     Window dummyRoot;
  961.     int dummyX, dummyY;
  962.     unsigned dummyBorderwidth, dummyDepth;
  963.  
  964.     if (psInfoPtr->prepass) {
  965.     return TCL_OK;
  966.     }
  967.  
  968.     /*
  969.      * The following call should probably be a call to Tk_SizeOfBitmap
  970.      * instead, but it seems that we are occasionally invoked by custom
  971.      * item types that create their own bitmaps without registering them
  972.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  973.      * it shouldn't matter here.
  974.      */
  975.  
  976.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  977.         &dummyX, &dummyY, (unsigned *) &width, (unsigned *) &height,
  978.         &dummyBorderwidth, &dummyDepth);
  979.     sprintf(string, "%d %d ", width, height);
  980.     Tcl_AppendResult(interp, string, (char *) NULL);
  981.     if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
  982.         width, height) != TCL_OK) {
  983.     return TCL_ERROR;
  984.     }
  985.     Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
  986.     return TCL_OK;
  987. }
  988.  
  989. /*
  990.  *--------------------------------------------------------------
  991.  *
  992.  * Tk_CanvasPsY --
  993.  *
  994.  *    Given a y-coordinate in canvas coordinates, this procedure
  995.  *    returns a y-coordinate to use for Postscript output.
  996.  *
  997.  * Results:
  998.  *    Returns the Postscript coordinate that corresponds to
  999.  *    "y".
  1000.  *
  1001.  * Side effects:
  1002.  *    None.
  1003.  *
  1004.  *--------------------------------------------------------------
  1005.  */
  1006.  
  1007. double
  1008. Tk_CanvasPsY(canvas, y)
  1009.     Tk_Canvas canvas;            /* Token for canvas on whose behalf
  1010.                      * Postscript is being generated. */
  1011.     double y;                /* Y-coordinate in canvas coords. */
  1012. {
  1013.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1014.  
  1015.     return psInfoPtr->y2 - y;
  1016. }
  1017.  
  1018. /*
  1019.  *--------------------------------------------------------------
  1020.  *
  1021.  * Tk_CanvasPsPath --
  1022.  *
  1023.  *    Given an array of points for a path, generate Postscript
  1024.  *    commands to create the path.
  1025.  *
  1026.  * Results:
  1027.  *    Postscript commands get appended to what's in interp->result.
  1028.  *
  1029.  * Side effects:
  1030.  *    None.
  1031.  *
  1032.  *--------------------------------------------------------------
  1033.  */
  1034.  
  1035. void
  1036. Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
  1037.     Tcl_Interp *interp;            /* Put generated Postscript in this
  1038.                      * interpreter's result field. */
  1039.     Tk_Canvas canvas;            /* Canvas on whose behalf Postscript
  1040.                      * is being generated. */
  1041.     double *coordPtr;            /* Pointer to first in array of
  1042.                      * 2*numPoints coordinates giving
  1043.                      * points for path. */
  1044.     int numPoints;            /* Number of points at *coordPtr. */
  1045. {
  1046.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1047.     char buffer[200];
  1048.  
  1049.     if (psInfoPtr->prepass) {
  1050.     return;
  1051.     }
  1052.     sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
  1053.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1054.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1055.     for (numPoints--, coordPtr += 2; numPoints > 0;
  1056.         numPoints--, coordPtr += 2) {
  1057.     sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
  1058.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1059.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1060.     }
  1061. }
  1062.  
  1063. /*
  1064.  *--------------------------------------------------------------
  1065.  *
  1066.  * GetPostscriptPoints --
  1067.  *
  1068.  *    Given a string, returns the number of Postscript points
  1069.  *    corresponding to that string.
  1070.  *
  1071.  * Results:
  1072.  *    The return value is a standard Tcl return result.  If
  1073.  *    TCL_OK is returned, then everything went well and the
  1074.  *    screen distance is stored at *doublePtr;  otherwise
  1075.  *    TCL_ERROR is returned and an error message is left in
  1076.  *    interp->result.
  1077.  *
  1078.  * Side effects:
  1079.  *    None.
  1080.  *
  1081.  *--------------------------------------------------------------
  1082.  */
  1083.  
  1084. static int
  1085. GetPostscriptPoints(interp, string, doublePtr)
  1086.     Tcl_Interp *interp;        /* Use this for error reporting. */
  1087.     char *string;        /* String describing a screen distance. */
  1088.     double *doublePtr;        /* Place to store converted result. */
  1089. {
  1090.     char *end;
  1091.     double d;
  1092.  
  1093.     d = strtod(string, &end);
  1094.     if (end == string) {
  1095.     error:
  1096.     Tcl_AppendResult(interp, "bad distance \"", string,
  1097.         "\"", (char *) NULL);
  1098.     return TCL_ERROR;
  1099.     }
  1100.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1101.     end++;
  1102.     }
  1103.     switch (*end) {
  1104.     case 'c':
  1105.         d *= 72.0/2.54;
  1106.         end++;
  1107.         break;
  1108.     case 'i':
  1109.         d *= 72.0;
  1110.         end++;
  1111.         break;
  1112.     case 'm':
  1113.         d *= 72.0/25.4;
  1114.         end++;
  1115.         break;
  1116.     case 0:
  1117.         break;
  1118.     case 'p':
  1119.         end++;
  1120.         break;
  1121.     default:
  1122.         goto error;
  1123.     }
  1124.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1125.     end++;
  1126.     }
  1127.     if (*end != 0) {
  1128.     goto error;
  1129.     }
  1130.     *doublePtr = d;
  1131.     return TCL_OK;
  1132. }
  1133.